{-# LANGUAGE TypeOperators              #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Orchsyn.Language.Base
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Basic opcodes and functions.
--
--------------------------------------------------------------------------------

module Ochre.Language.Base
  (

  -- * Variable initialization
    initglobal
  , init
  , divz

  -- * Arithmetic and logical operators
  , (&&)
  , (||) 
  , (%)


  -- * Math functions
  , int
  , frac
  , abs
  , exp
  , log
  , log10
  , sqrt
  , powoftwo
  , logbtwo


  -- * Trig functions
  , sin
  , cos
  , tan
  , sininv
  , cosinv
  , taninv
  , sinh
  , cosh
  , tanh


  -- * Amplitude functions
  , dbamp
  , ampdb

  -- * Random functions
  , rnd
  , birnd


  -- * Opcode equivalents of functions
  , sum
  , product

  , pow
  , taninv2
  , mac
  , maca


  -- * Pitch converots
  , octpch
  , cpspch
  , pchoct
  , octcps
  , cpsoct

  , cps2pch
  , cpsxpch


  ) where


import Ochre.Compiler.Operators
import Ochre.Compiler.VarId
import Ochre.Language.Prim



import Prelude hiding ( init, negate, (&&), (||), (^)
                      , abs, exp, log, sqrt
                      , sin, cos, tan, sinh, cosh, tanh
                      , sum, product 
                      )


-- Helper


{-


-- | Note - list of args need to be the same type, use cast where
-- necessary.
--
-- Also, a backslash in the input string will need escaping with 
-- another baskslash to be transmitted to Csound.
--
printf :: Signal sig => IString -> [sig] -> Unit
printf ss sigs = 
    wrapE $ opcode "printf" ty (unwrapE ss : map unwrapE sigs)
  where
    tys = case sigs of (x:_) -> [TyList (getTypeE x)]; _ -> []
    ty  = TyFun (TyString : tys) TyUnit

-}


-- | Csound\'s @init@ for global (orchestra level) variables.
--
initglobal :: IKA_Signal rate => (String ::: rate) -> IFloat -> Orch (Sig rate)
initglobal (ss ::: rid) val = 
    globalAssign ss (rateId rid) (PrimId "init") [getPValue val] 


-- | Csound\'s @init@ for local (instrument level) variables.
--
init :: IKA_Signal a => Sig a -> GenSig a
init xa = opcode1 "init" [ getPValue xa ]

divz :: IKA_Signal a => Sig a -> Sig a -> Sig a -> GenSig a
divz xa xb xsubst = 
    opcode1 "divz" [ getPValue xa,    getPValue xb
                   , getPValue xsubst ]



--------------------------------------------------------------------------------
-- Arithmetic and logical operators


infixr 3 &&

(&&) :: IBool -> IBool -> IBool
(&&) = binOp LOG_AND


infixr 2 ||


(||) :: IBool -> IBool -> IBool
(||) = binOp LOG_OR


-- No power_of (^) as its use is dicouraged.

infixl 7 %

(%) :: IInt -> IInt -> IInt
(%) = binOp MODULUS


--------------------------------------------------------------------------------
-- Math functions



-- | I or K rate only (A rate Csound 5).
--
int             :: IKA_Signal a => Sig a -> IInt 
int x           = function "int" [ getPValue x ]



-- | I or K rate only (A rate Csound 5).
--
frac            :: IKA_Signal a => Sig a -> Sig a
frac x          = function "frac" [ getPValue x ]


-- | I or K rate only.
--
powoftwo        :: IK_Signal a => Sig a -> Sig a
powoftwo x      = function "powoftwo" [ getPValue x ]


-- | I or K rate only.
--
logbtwo         :: IK_Signal a => Sig a -> Sig a
logbtwo x       = function "logbtwo" [ getPValue x ]


abs             :: IKA_Signal a => Sig a -> Sig a 
abs x           = function "abs" [ getPValue x ]

exp             :: IKA_Signal a => Sig a -> Sig a 
exp x           = function "exp" [ getPValue x ]

log             :: IKA_Signal a => Sig a -> Sig a 
log x           = function "log" [ getPValue x ]

log10           :: IKA_Signal a => Sig a -> Sig a 
log10 x         = function "log10" [ getPValue x ]

sqrt            :: IKA_Signal a => Sig a -> Sig a 
sqrt x          = function "sqrt" [ getPValue x ]


--------------------------------------------------------------------------------
-- Trig functions

sin             :: IKA_Signal a => Sig a -> Sig a 
sin x           = function "sin" [ getPValue x ]

cos             :: IKA_Signal a => Sig a -> Sig a 
cos x           = function "cos" [ getPValue x ]

tan             :: IKA_Signal a => Sig a -> Sig a 
tan x           = function "tan" [ getPValue x ]


sininv          :: IKA_Signal a => Sig a -> Sig a 
sininv x        = function "sininv" [ getPValue x ]

cosinv          :: IKA_Signal a => Sig a -> Sig a 
cosinv x        = function "cosinv" [ getPValue x ]

taninv          :: IKA_Signal a => Sig a -> Sig a 
taninv x        = function "taninv" [ getPValue x ]

sinh            :: IKA_Signal a => Sig a -> Sig a 
sinh x          = function "sinh" [ getPValue x ]

cosh            :: IKA_Signal a => Sig a -> Sig a 
cosh x          = function "cosh" [ getPValue x ]

tanh            :: IKA_Signal a => Sig a -> Sig a 
tanh x          = function "tanh" [ getPValue x ]


--------------------------------------------------------------------------------
-- Amplitude functions

-- | I or K rate only.
--
dbamp           :: IK_Signal a => Sig a -> Sig a 
dbamp x         = function "dbamp" [ getPValue x ]


-- | 
ampdb           :: IK_Signal a => Sig a -> Sig a 
ampdb x         = function "ampdb" [ getPValue x ]


--------------------------------------------------------------------------------
-- Random functions

-- | I or K rate only.
--
rnd             :: IK_Signal a => Sig a -> Sig a
rnd x           = function "rnd" [ getPValue x ]
 
-- | I or K rate only.
--
birnd           :: IK_Signal a => Sig a -> Sig a
birnd x         = function "birnd" [ getPValue x ]




--------------------------------------------------------------------------------
-- Opcode equivalents of functions



sum :: [ASig] -> GenASig
sum asigs = 
    opcode1 "sum" (map getPValue asigs)


product :: [ASig] -> GenASig
product asigs = 
    opcode1 "product" (map getPValue asigs)




pow :: IKA_Signal a => Sig a -> Sig a -> GenSig a
pow xarg xpow = 
    opcode1 "pow" [ getPValue xarg, getPValue xpow ]



taninv2 :: IKA_Signal a => Sig a -> Sig a -> GenSig a
taninv2 x y = 
    opcode1 "taninv2" [ getPValue x, getPValue y ]



-- | Warning list should be non-empty.
--
mac :: [(ASig, KSig)] -> GenASig
mac xs = 
    opcode1 "mac" $ concatMap step xs
  where
    step (a,b) = [getPValue a, getPValue b]



maca :: ASig -> ASig -> [ASig] -> GenASig
maca asig1 asig2 asigs = 
    opcode1 "maca" (getPValue asig1 : getPValue asig2 : map getPValue asigs)



--------------------------------------------------------------------------------
-- Pitch conversion


-- | Convert a pitch-class value to octave-point-decimal.
-- 
-- I or K rate only.
--
octpch          :: IK_Signal a => Sig a -> Sig a
octpch x        = function "octpch" [ getPValue x ]


-- | I or K rate only.
--
cpspch          :: IK_Signal a => Sig a -> Sig a
cpspch x        = function "cpspch" [ getPValue x ]

-- | I or K rate only.
--
pchoct          :: IK_Signal a => Sig a -> Sig a
pchoct x        = function "pchoct" [ getPValue x ]


-- | I or K rate only.
octcps          :: IK_Signal a => Sig a -> Sig a
octcps x        = function "octcps" [ getPValue x ]



-- | No rate restriction.
--
cpsoct      :: IKA_Signal a => Sig a -> Sig a 
cpsoct x    = function "cpsoct" [ getPValue x ]


-- Design note - here Csound uses @x@ for the version with more 
-- args. Is this a convention used elsewhere?

cps2pch :: ISig -> ISig -> GenISig
cps2pch ipch iequal = 
    opcode1 "cps2pch" [ getPValue ipch, getPValue iequal ]


-- | returns an IRate float...

cpsxpch :: ISig  -> ISig -> ISig -> ISig -> GenISig
cpsxpch ipch iequal irepeat ibase = 
    opcode1 "cps2pch" [ getPValue ipch,    getPValue iequal
                      , getPValue irepeat, getPValue ibase ]
